home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 001-025 / disk_013 / alg1.bas < prev    next >
BASIC Source File  |  1992-05-06  |  4KB  |  129 lines
  1. 10    '***  ALGEBRA AND GEOMETRY PROGRAM
  2. 20    '** for the IBM PC...requires 32K and Color/Graphics
  3. 30    ON ERROR GOTO 1150
  4. 40    CLR
  5. 70    REM
  6. 80    SCREEN 1,2,0:WIDTH 80:SCNCLR : PRINT "ALGEBRA Graphics Program"
  7. 90    PRINT "    Steve VanArsdale"
  8. 100   PRINT "Mt.Prospect, Illinois  312-259-7224"
  9. 110   PRINT
  10. 120   PRINT "SELECT algebra function:"
  11. 130   PRINT "A ... for the SINE of X"
  12. 140   PRINT "B ... for the COSINE of X"
  13. 150   PRINT "C ... for the TANGENT of X"
  14. 160   PRINT "D ... for the SECANT of X"
  15. 170   PRINT "E ... for the COTANGENT of X"
  16. 180   PRINT "F ... for the COSECANT of X"
  17. 190   PRINT "G ... for the INVERSE HYPERBOLIC SINE of X"
  18. 200   PRINT "H ... for the SQUARE ROOT of X"
  19. 210   PRINT " > ";:GETKEY CHOICE$
  20. 220   ON ASC(CHOICE$)-64 GOSUB 1300,1320,1340,1360,1380,1400,1420,1440,1460
  21. 230   GOTO 310
  22. 300   GOTO 70
  23. 310   PRINT "DEPTH OF ";FCTN$;" GRAPH (0 TO 50): ";:INPUT "",DEPTH
  24. 320   IF DEPTH < 0 OR DEPTH > 50 THEN GOTO 310
  25. 330   SCNCLR:SCREEN 0,2,0 :WIDTH 40
  26. 340   '****   GRAPHICS ROUTINE FOR ALGEBRAIC FUNCTIONS ****
  27. 350   SCNCLR
  28. 360   'SCREEN 1,0:COLOR 0,1
  29. 370   C=100:R=100
  30. 380   '** AXIS DRAWING ROUTINE
  31. 390   GOSUB 1180
  32. 400   '** PLOTTING PARAMETERS DISPLAY
  33. 410   PRINT AT(1,17); "GRAPH of:"
  34. 420   PRINT AT (1,18); FCTN$
  35. 430   PRINT AT (1,20); "  X     Y"
  36. 440   '** PLOTTING ROUTINE
  37. 450   X=0:Y=0:XX=-1:YY=FNFCTN(XX):DRAW (100,100)
  38. 460   FOR X = -1 TO 7 STEP .1
  39. 470   PRINT AT (1,21);:PRINT USING "##.##";X
  40. 480   REM
  41. 490   Y = FNFCTN(X)
  42. 500   YLIMIT=98-30*Y : DEPTHLIMIT=100-30*Y-DEPTH : IF YLIMIT < 0 OR YLIMIT > 200 OR DEPTHLIMIT < 0 THEN GOTO 570
  43. 510   ON ERROR GOTO 1270
  44. 520   PRINT AT (7,21);:PRINT USING "##.##";Y
  45. 530   DRAW (20*X+100,100-30*Y),2
  46. 540   IF DEPTH <> 0 THEN DRAW (20*X+101,99-30*Y TO 20*X+100+DEPTH,100-30*Y-DEPTH),1
  47. 550   DRAW (20*XX+100,100-30*YY TO 20*X+100,100-30*Y),2
  48. 560   IF DEPTH <> 0 THEN DRAW (20*XX+100+DEPTH,100-30*YY-DEPTH TO 20*X+100+DEPTH,100-30*Y-DEPTH),2
  49. 570   XX=X:YY=Y
  50. 580   NEXT X
  51. 590   GOSUB 1180
  52. 600   PRINT AT (1,23); "ENTER  X  TO EXIT";:VALUE$=INPUT$(1)
  53. 610   IF VALUE$ <> "X" AND VALUE$ <> "x" THEN GOTO 70 ELSE SCNCLR
  54. 620   '****  SPECIAL EXIT DISPLAY ****
  55. 630   '** AXIS DRAWING SUBROUTINE
  56. 640   GOSUB 1180
  57. 650   '** PLANE GRID DRAWING ROUTINE
  58. 660   FOR X = 10 TO R-10 STEP 10
  59. 670   DRAW (C+X,R-X TO 105+C+X,R-X),1
  60. 680   DRAW (C+X,R-X TO C+X,0),1
  61. 690   DRAW (C,R-X TO 195-X,5),1
  62. 700   DRAW (C+X,R TO 195+X,5),1
  63. 710   NEXT X
  64. 720   PRINT AT (22,1); " Z axis"
  65. 730   '** HOOP ROUTINE
  66. 740   CIRCLE (160,90),50,1
  67. 750   'FOR I = 1 TO 20 STEP
  68. 760   'CIRCLE STEP (1,-1),50,1
  69. 770   'NEXT I
  70. 780   'CIRCLE (160,90),50,1
  71. 790   '** ELLIPTICAL TUBE ROUTINE
  72. 800   'CIRCLE (155,90),25,1
  73. 810   'FOR I = 1 TO 35
  74. 820   'CIRCLE STEP (1,1),25,1
  75. 830   'NEXT I
  76. 840   'CIRCLE STEP (1,1),25,1
  77. 850   CIRCLE (155,90),25,.5
  78. 860   'FOR I = 1 TO 20
  79. 870   'CIRCLE STEP (1,-1),24,1,,,.5
  80. 880   'NEXT I
  81. 890   CIRCLE (155,90),25,.5
  82. 900   '***  CONE ROUTINE
  83. 910   CIRCLE (45,55),38,3
  84. 920   'FOR I = 1 TO 38
  85. 930   'CIRCLE STEP (+1,-1),38-I,(I MOD 2)+2,,,1
  86. 940   'NEXT I
  87. 950   CIRCLE (45,55),38,1
  88. 960   '**  GLOBE ROUTINE
  89. 970   CIRCLE (245,170),1,2
  90. 980   'FOR I = 1 TO 10 STEP 1
  91. 990   'CIRCLE STEP (+I/4,-I/4),I*4,1,,,1
  92. 1000  'NEXT I
  93. 1010  'FOR I = 10 TO 0 STEP -1
  94. 1020  'CIRCLE STEP (+I/4,-I/4),I*4,2,,,1
  95. 1030  'NEXT I
  96. 1040  DRAW  (TO 245,170),3
  97. 1150  '**** TERMINATION LOGIC
  98. 1160  SCNCLR: PRINT "ALGEBRA Program Terminated."
  99. 1170  END
  100. 1180  '****  AXIS DRAWING SUBROUTINE ****
  101. 1190  '****  AXIS DRAWING SUBROUTINE ****
  102. 1200  DRAW (C,0 TO C,199),6
  103. 1210  DRAW (90,110 TO 200,0),6
  104. 1220  DRAW (0,R TO 319,R),6
  105. 1230  PRINT AT (1,13); "X axis"
  106. 1240  PRINT AT (10,2); "Y axis"
  107. 1250  PRINT AT (22,1); " Z axis"
  108. 1260  RETURN
  109. 1270  '****  CALCULATION ERROR HANDLER
  110. 1280  RESUME 390
  111. 1290  SCNCLR : PRINT "ALGEBRA Graphics Program"
  112. 1300  REM FUNCTION DEFINITION SUBROUTINES
  113. 1310  ' SINE
  114. 1320  ''DEF FNFCTN(X)=SIN(X):FCTN$="SIN(X)":RETURN
  115. 1330  ' COSINE
  116. 1340  ''DEF FNFCTN(X)=COS(X):FCTN$="COSINE(X)":RETURN
  117. 1350  ' TANGENT
  118. 1360  ''DEF FNFCTN(X)=TAN(X):FCTN$="TANGENT(X)":RETURN
  119. 1370  ' SECANT
  120. 1380  DEF FNFCTN(X)=1/COS(X):FCTN$="SECANT(X)":RETURN
  121. 1390  ' COTANGENT
  122. 1400  ' DEF FNFCTN(X)=1/TAN(X):FCTN$="COTANGENT(X)":RETURN
  123. 1410  ' COSECANT
  124. 1420  ' DEF FNFCTN(X)=1/SIN(X):FCTN$="COSECANT(X)":RETURN
  125. 1430  ' INVERSE HYPERBOLIC SINE
  126. 1440  ' DEF FNFCTN(X)=LOG(X+SQR(X*X+1)):FCTN$="INVERSE HYPERBOLIC SINE(X)":RETURN
  127. 1450  ' SQUARE ROOT
  128. 1460  ' DEF FNFCTN(X)=SQR(ABS(X)):FCTN$="SQ.RT(X)":RETURN
  129.